home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / dassl / ddanrm.f < prev    next >
Text File  |  1996-07-19  |  2KB  |  46 lines
  1.       DOUBLE PRECISION FUNCTION DDANRM (NEQ, V, WT, RPAR, IPAR)
  2. C***BEGIN PROLOGUE  DDANRM
  3. C***SUBSIDIARY
  4. C***PURPOSE  Compute vector norm for DDASSL.
  5. C***LIBRARY   SLATEC (DASSL)
  6. C***TYPE      DOUBLE PRECISION (SDANRM-S, DDANRM-D)
  7. C***AUTHOR  PETZOLD, LINDA R., (LLNL)
  8. C***DESCRIPTION
  9. C-----------------------------------------------------------------------
  10. C     THIS FUNCTION ROUTINE COMPUTES THE WEIGHTED
  11. C     ROOT-MEAN-SQUARE NORM OF THE VECTOR OF LENGTH
  12. C     NEQ CONTAINED IN THE ARRAY V,WITH WEIGHTS
  13. C     CONTAINED IN THE ARRAY WT OF LENGTH NEQ.
  14. C        DDANRM=SQRT((1/NEQ)*SUM(V(I)/WT(I))**2)
  15. C-----------------------------------------------------------------------
  16. C***ROUTINES CALLED  (NONE)
  17. C***REVISION HISTORY  (YYMMDD)
  18. C   830315  DATE WRITTEN
  19. C   901009  Finished conversion to SLATEC 4.0 format (F.N.Fritsch)
  20. C   901019  Merged changes made by C. Ulrich with SLATEC 4.0 format.
  21. C   901026  Added explicit declarations for all variables and minor
  22. C           cosmetic changes to prologue.  (FNF)
  23. C***END PROLOGUE  DDANRM
  24. C
  25.       INTEGER  NEQ, IPAR(*)
  26.       DOUBLE PRECISION  V(NEQ), WT(NEQ), RPAR(*)
  27. C
  28.       INTEGER  I
  29.       DOUBLE PRECISION  SUM, VMAX
  30. C
  31. C***FIRST EXECUTABLE STATEMENT  DDANRM
  32.       DDANRM = 0.0D0
  33.       VMAX = 0.0D0
  34.       DO 10 I = 1,NEQ
  35.         IF(ABS(V(I)/WT(I)) .GT. VMAX) VMAX = ABS(V(I)/WT(I))
  36. 10      CONTINUE
  37.       IF(VMAX .LE. 0.0D0) GO TO 30
  38.       SUM = 0.0D0
  39.       DO 20 I = 1,NEQ
  40. 20      SUM = SUM + ((V(I)/WT(I))/VMAX)**2
  41.       DDANRM = VMAX*SQRT(SUM/NEQ)
  42. 30    CONTINUE
  43.       RETURN
  44. C------END OF FUNCTION DDANRM------
  45.       END
  46.